home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / sinscr2.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  2KB  |  70 lines
  1.  
  2. program SinusScroll;
  3. { Enhanced sinus-scroll, by Bas van Gaalen, Holland, PD }
  4. const
  5.   GSeg = $a000;
  6.   Sofs = 140; Samp = 40; Slen = 255;
  7.   Size = 2; Curve = 3;
  8.   Xmax = 279 div Size; Ymax = 7;
  9.   ScrSpd = -1;
  10.   ScrText : string =
  11.     ' Hai world... This looks a bit like the scroll of the second part'+
  12.     ' of Future Crew''s Unreal demo (part one)...     It''s not filled'+
  13.     ' but it sure looks nicer (imho)...                               ';
  14. type SinArray = array[0..Slen] of word;
  15. var Stab : SinArray; Fseg,Fofs : word;
  16.  
  17. procedure CalcSinus; var I : word; begin
  18.   for I := 0 to Slen do Stab[I] := round(sin(I*4*pi/Slen)*Samp)+Sofs; end;
  19.  
  20. procedure GetFont; assembler; asm
  21.   mov ax,1130h; mov bh,1; int 10h; mov Fseg,es; mov Fofs,bp; end;
  22.  
  23. procedure SetGraphics(Mode : word); assembler; asm
  24.   mov ax,Mode; int 10h end;
  25.  
  26. function keypressed : boolean; assembler; asm
  27.   mov ah,0bh; int 21h; and al,0feh; end;
  28.  
  29. procedure Scroll;
  30. type
  31.   ScrArray = array[0..Xmax,0..Ymax] of byte;
  32.   PosArray = array[0..Xmax,0..Ymax] of word;
  33. var
  34.   PosTab : PosArray;
  35.   BitMap : ScrArray;
  36.   X,I,SinIdx : word;
  37.   Y,ScrIdx,CurChar : byte;
  38. begin
  39.   fillchar(BitMap,sizeof(BitMap),0);
  40.   fillchar(PosTab,sizeof(PosTab),0);
  41.   ScrIdx := 1; SinIdx := 0;
  42.   repeat
  43.     Curchar := ord(ScrText[ScrIdx]);
  44.     inc(ScrIdx); if ScrIdx = length(ScrText) then ScrIdx := 1;
  45.     for I := 0 to 7 do begin
  46.       move(BitMap[1,0],BitMap[0,0],(Ymax+1)*Xmax);
  47.       for Y := 0 to Ymax do
  48.         if ((mem[Fseg:Fofs+8*CurChar+Y] shl I) and 128) <> 0 then
  49.           BitMap[Xmax,Y] := ((ScrIdx+Y-I) mod 60)+32 else BitMap[Xmax,Y] := 0;
  50.       while (port[$3da] and 8) <> 0 do;
  51.       while (port[$3da] and 8) = 0 do;
  52.       for X := 0 to Xmax do
  53.         for Y := 0 to Ymax do begin
  54.           mem[GSeg:PosTab[X,Y]] := 0;
  55.           PosTab[X,Y] := (Size*Y+STab[(SinIdx+X+Curve*Y) mod SLen])*320+Size*X+STab[(X+Y) mod SLen]-SOfs;
  56.           mem[GSeg:PosTab[X,Y]] := BitMap[X,Y];
  57.         end;
  58.       SinIdx := (SinIdx+ScrSpd) mod SLen;
  59.     end;
  60.   until keypressed;
  61. end;
  62.  
  63. begin
  64.   CalcSinus;
  65.   GetFont;
  66.   SetGraphics($13);
  67.   Scroll;
  68.   SetGraphics(3);
  69. end.
  70.